OutCode.mesa 2-Sep-78 12:59:59 Page 1 

-- file OutCode.mesa 

-- last modified by Sweet. July 14. 1978 3:26 PM 

DIRECTORY 

AltoDefs: FROM "altodefs" USING [Address, BYTE. PageSize], 

Code: FROM "code" USING [CodePassInconsistancy , codeptr], 

CodeDefs: FROM "codedefs" USING [CCIndex, CCItem, CCNull, ChunkBase, FreeChunk, NULLf ileindex]. 

ComData: FROM "comdata" USING [codeSeg, dStar, fgTable, linkCount, mainBody, mtRoot. nBodies, nSigCod 
**es, objectFrameSize, objectStream, stopping]. 

CompilerDefs: FROM "compilerdefs" USING [nextFilePage] , 

ControlDefs: FROM "controldefs" USING [codebaseOff set. CSegPrefix, EntryVectorltem, EPRange. InstWord 
** MaxAl 1 ocSl otl 

FOpCodes: FROM "fopcodes" USING [qBLTC, qGADRB. qLADRB], 

InlineDefs: FROM "inlinedefs" USING [BITOR. BITSHIFT], 

LitDefs: FROM "litdefs" USING [EnumerateLocalStrings. EnumerateMasterStrings. MSTIndex, STIndex, stty 
♦*pe], 

Mopcodes: FROM "mopcodes" USING [zJIB. zJIW, zNOOP], 

P5ADefs: FROM "pSadefs" USING [CioutO, Cioutl. compufteframesize. P5Error, RequireStack, wordsforsei], 

P5BDefs: FROM "p5bdefs" USING [CIW, pushlitval]. 

StreamDefs: FROM "streamdefs" USING [Getlndex, Setlndex. Streamlndex, WriteBlock]. 

StringDefs: FROM "stringdefs" USING [WordsForString] . 

SymDefs: FROM "symdefs" USING [Bodylnfo, bodytype. BTIndex, Bytelndex, CBTIndex. CSEIndex. CTXIndex. 
**FGTEntry, HTIndex, ISEIndex, recordCSEIndex, SEIndex. SERecord, setype]. 

SymTabDefs: FROM "symtabdefs" USING [UnderType]. 

SystemDefs: FROM "systemdefs" USING [AllocateHeapNode, AllocatePages , Al locateSegment, FreeHeapNode. 
**FreePages, FreeSegment] , 

TableDefs: FROM "tabledefs" USING [TableBase. TableLimit. TableNotif ier], 

TreeDefs: FROM "treedefs" USING [treetype]; 

DEFINITIONS FROM CodeDefs; 

OutCode: PROGRAM 

IMPORTS MPtr: ComData. CPtr: Code. CodeDefs. CompilerDefs, LitDefs. PSADefs, PSBDefs, StreamDefs. S 
**tringDefs, SymTabDefs, SystemDefs 
EXPORTS CodeDefs, P5BDefs 
SHARES LitDefs - 
BEGIN 
OPEN PSADefs, P5BDefs; 

-- imported definitions 

Address: TYPE = AltoDefs. Address; 

BYTE: TYPE « Al toDef s .BYTE; 

PageSize: INTEGER « AltoDef s . PageSize; 

InstWord: TYPE = ControlDefs. InstWord; 

codebaseOffset: CARDINAL = ControlDefs. codebaseOff set; 

Bodylnfo: TYPE = SymDefs .Bodylnfo; 
BTIndex: TYPE * SymDefs .BTIndex; 
CBTIndex: TYPE = SymDefs .CBTIndex; 
Bytelndex: TYPE = SymDefs .Bytelndex; 
CSEIndex: TYPE == SymDefs .CSEIndex; 
CTXIndex: TYPE = SymDefs .CTXIndex; 
FGTEntry: TYPE = SymDefs . FGTEntry; 
HTIndex: TYPE = SymDefs .HTIndex; 
ISEIndex: TYPE = SymDefs .ISEIndex; 
recordCSEIndex: TYPE » SymDefs .recordCSEIndex; 
SEIndex: TYPE « SymDefs. SEIndex; 
SERecord: TYPE » SymDefs. SERecord; 

STIndex: TYPE = Li tDefs .STIndex; 
MSTIndex: TYPE » LitDefs .MSTIndex; 

cb: ChunkBase; -- code base (local copy) 

seb: TableDefs .TableBase; 
bb: TableDefs .TableBase; 
stb: TableDefs. TableBase; 

OutCodeNotify: PUBLIC TableDefs. TableNotif ier - 

BEGIN -- called by allocator whenever table area is repacked 
cb ^ LOOPHOLE[base[TreeDefs. treetype]]; 
seb <- base[SymDefs. setype]; bb ^ base[SymOefs. bodytype]; 
stb ♦- base[LitDefs .sttype]; 
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RETURN 
END; 

FileSequenceError: SIGNAL ■ CODE; 

fgt: DESCRIPTOR FOR ARRAY OF FGTEntry; 

fgti, fgtpages: CARDINAL; 

codebase, entrybase: StreamDefs.Streamlndex; 

entryvector: DESCRIPTOR FOR ARRAY OF ControlDef s.EntryVectorltem; 

parity: {even, odd}; 
codeindex: CARDINAL; 
buffer: InstWord; 

startcodefile: PUBLIC PROCEDURE - 
BEGIN -- called to set up bodytable and init binary file header 
OPEN MPtr, ControlDefs, SystemDefs, StreamDefs; 
prefix: CSegPrefix; 

ngfi: CARDINAL - (MAX[nBodies, nSigCodes] + (EPRange-l))/EPRange; 
IF ngfi -IN [1..4] THEN P5ADef s.P6Error[833]; 
-- should be 256 (fix ControlDefs) 
IF linkCount > 377B THEN P5ADef s .P5Error[834] ; 
prefix ♦- [ 

swapinfo: 0, 

stops: MPtr. stopping, 

fill: IF MPtr.dStar THEN 1 ELSE 0. 

ngfi: ngfi. 

nlinks: linkCount, 

entry: ]; 
codeSeg.base ♦- CompilerDef s .nextFilePage[]; 
fgti *- -1; fgtpages <- 1; 
codebase <- GetIndex[objectStream]; 

[] <- WriteBlock[objectStreani, ©prefix, SIZE[CSegPref ix]]; 
entrybase <- GetIndex[objectStream]; 

codeindex ♦- SIZE[CSegPref ix]+nBodies*SIZE[EntryVectorItem3; 
parity ^ even; 

SetIndex[objectStream, Streamlndex[page: codebase. page , byte: 2*codeindex]]; 
fgt <- DESCRIPTOR[AnocatePages[fgtpages], (f gtpages*PageSize)/SIZE[FGTEntry]]; 
entryvector ^ DESCRIPTOR[AnocateSegment[nBodies*SIZE[EntryVectorItem]] , nBodies]; 
RETURN 
END; 

movetocodeword: PUBLIC PROCEDURE RETURNS [CARDINAL] - 
BEGIN 
IF parity = odd THEN 

BEGIN 

buffer. oddbyte ^ 377B; MPtr.objectStream.put[MPtr.objectStreain, buffer]; 

parity <- even; codeindex ^ codeindex+1; 

END; 
RETURN [codeindex] 
END; 

writecodeword: PUBLIC PROCEDURE [w: WORD] - 
BEGIN 

IF parity ff even THEN P5ADef s .P5Error[835] ; 
MPtr .objectStream. pu t [MPtr. Ob jectStr earn, w]; 
codeindex ♦- codeindex+1; 
RETURN 
END; 

writecodebyte: PROCEDURE [b: BYTE] - 
BEGIN 
IF parity - odd THEN 

BEGIN 

buffer. oddbyte <- b; MPtr. objectStream. put[MPtr. objectStream, buffer]; 

parity <- even; codeindex <- codeindex+1; 

END 
ELSE BEGIN buffer .evenbyte <- b; parity <- odd; END; 
RETURN 
END; 



newfgtentry: PROCEDURE [fi, c1: Bytelndex] 
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BEGIN -- enters new value into fgt 

i: INTEGER; 

oldfgt: DESCRIPTOR FOR ARRAY OF FGTEntry; 

IF (fgti <r fgti+1) >■ LENGTH[fgt] THEN 

BEGIN 

OPEN SystemDefs; 

oldfgt ^ fgt; fgtpages <- fgtpages+1; 

fgt <- DESCRIPTOR^ 

All ocateP ages [fgtpages], 
(fgtpages*PageSize)/SIZE[FGTEntry]3; 

FOR i IN [O..LENGTH[oldfgt]) DO fgt[i] ♦- oldfgt[i] ENDLOOP; 

FreePages[BASE[oldfgt]]; 

END; 
fgt[fgti] ^ FGTEntry[findex: fi. cindex: ci]; 
RETURN 
END; 

outbinary: PUBLIC PROCEDURE [bti: CBTIndex. start: CCIndex] ■ 
BEGIN -- outputs binary bytes for body bti starting at start 
cfi: Bytelndex; 
c, c j , nextc: CCIndex; 
bodystart: Address; 
offset, e, fs, nw: CARDINAL; 
bytetable, even: BOOLEAN; 
leftbyte: WORD; 

bodysei: POINTER [0. .TableDef s.TableLimit) TO transfer constructor SERecord; 
sei: recordCSEIndex; 

bodystart *- movetocodeword[]; 
offset ♦- bodystart * 2; 

FOR c ^ start, cb[c].flink UNTIL c - CCNull DO 
WITH cc:cb[c] SELECT FROM 

code => offset <- offset + cc.isize + cc.pad; 
other -> WITH cc SELECT FROM 
table "> 
BEGIN 

OPEN InlineDefs; 

offset ♦- offset + tablecodebytes + pad; 
taboffset ♦- bodystart; 
bytetable ^ btab *- byteablejumps[f 1 ink]; 
even ♦- TRUE; 

FOR cj <r fiink. cb[cj].flink DO 
WITH cb[cj] SELECT FROM 
jump «> 

IF jtype - JumpC THEN 
BEGIN 

IF bytetable THEN 
BEGIN 
IF even THEN 

leftbyte ♦- BITSHIFT[jbytes, 8] 
ELSE 

writecodeword[BITOR[ leftbyte, j bytes]]; 
even ^ ~even; 
END 
ELSE writecodeword[jbytes]; 
END 
ELSE EXIT; 
ENDCASE «> EXIT; 
ENDLOOP; 
IF bytetable AND -even THEN 

writecodeword[BIT0R[leftbyte,377B]]; 
bodystart <- codeindex; 
END; 
ENDCASE; 
ENDCASE; 
ENDLOOP; 
e ♦- (bb+bti) .entrylndex; 
WITH (bb+bti). info SELECT FROM 
Internal ■> 
BEGIN 

IF bti - MPtr.mainBody THEN 
BEGIN 

writecodeword[MPtr.objectFrameSize]; 
bodystart +- bodystart+1; 
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END; 
fs ♦- computef ramesize[frameSize]; 
IF fs >» ControlDefs.MaxAnocSlot THEN 
BEGIN 

writ0codeword[fs]; 
bodystart <- bodystart+1; 
fs <- ControlDefs.MaxAnocSlot; 
END; 
offset ^ bodystart*2; 
entryvector[0].framesize ♦- fs; 
newfgtentry[cf i <- sourcelndex. offset]; 
END; 
ENDCASE «> P5ADefs.P6Error[8363; 
bodysei ♦- LOOPHOLE[SymTabDefs.UnderType[(bb+bti) . ioType]]; 
sei <- (seb+bodysei) . inrecord; 
entryvector[e].nparams <- wordsforsei[sei]; 
entryvector[e]. defaults ♦- FALSE; 
entryvector[e]. initialpc <- [bodystart]; 
(bb+bti) .info <- 

BodyInfo[Externa1[origin: offset, bytes: » startlndex: fgti, indexLength: ]]; 
FOR c ^ start, nextc UNTIL c - CCNull DO 
WITH cc:cb[c] SELECT FROM 
code "> 
BEGIN 

IF cc.sourcef ileindex # NULLf ileindex THEN 
BEGIN 
IF cfi < cc.sourcef ileindex THEN 

newfgtentry[cf i ♦- cc.sourcef ileindex, offset]; 
IF cfi > cc.sourcef ileindex THEN 

BEGIN SIGNAL FileSequenceError ; cfi <- cc. sourcef ileindex; END; 
END; 
SELECT cc.isize FROM 

1 «> 
BEGIN 
writecodebyte[cc. inst]; 

IF cc.pad # THEN [] ♦- movetocodeword[] ; 
END; 

2 «> 
BEGIN 

IF cc.pad # THEN 

BEGIN 

IF parity » even THEN SIGNAL CPtr.CodePassInconsistancy ; 

writecodebyte[Mopcodes.zNOOP]; 

END; 
writecodebyte[cc. inst]; 
writecodebyte[cc.parameters[l]]; 
END; 

3 »> 
BEGIN 

writecodebyte[cc. inst]; 
IF cc.pad § THEN 

BEGIN 

IF parity « even THEN SIGNAL CPtr.CodePassInconsistancy; 
[] <r movetocodeword[] ; 
END; 
wr i t ecode by te[cc. parameters [2]]; 
writecodebyte[cc.parameters[l]]; 
END; 
ENDCASE »> P5ADefs.P5ErrorC8373; 
offset ♦- offset+cc.isize+cc.pad; 
END; 
other => WITH cc SELECT FROM 
table «> 
BEGIN 

CPtr.codeptr ^ c; 

C1W[IF btab THEN Mopcodes .zJIB ELSE Mopcodes.zJIW, taboffset]; 
cb[CPtr.codeptr].pad <- pad; 
END; 
startbody ■> 
BEGIN 

WITH (bb+index).info SELECT FROM 
Internal ■> 

newfgtentry[cf i <- sourcelndex, offset]; 
ENDCASE «> P5ADefs.P5Error[838]; 
(bb+index) .info <- BodyInfo[Externa1[origin: offset, bytes: , 
startlndex: fgti, indexLength: ]]; 



OutCode.mesa 2-Sep-78 12:59:59 Page 5 



END; 
endbody ■> 
BEGIN 

WITH (bb+ind0x).info SELECT FROM 
External ■> 
BEGIN 

indexLength ^ fgti-startIndex+1; 
bytes ♦" offset - origin; 
END; 
ENDCASE; 
END; 
ENDCASE; 
ENDCASE; 
nextc ^ cb[c].flink; 
WITH cb[c] SELECT FROM 

code "> nw <- isize-l+SIZE[cod0 CCItem]; 
label -> nw <- SIZE[label CCItem]; 
jump »> nw *- SIZE[jump CCItem]; 
other "> nw ^ SIZE[other CCItem]; 
ENDCASE; 
CodeDefs.FreeChunk[c, nw]; 
WITH (bb+bti).info SELECT FROM 
External ■> 
BEGIN 

indexLength <- f gti-startIndex+1; 
bytes ♦- offset - (bodystart*2) ; 
END; 
ENDCASE; ' 
ENDLOOP; 
RETURN 
END; 



byteablejumps: PROCEDURE [j: CCIndex] RETURNS [BOOLEAN] 
BEGIN 
DO 
WITH cb[j] SELECT FROM 
jump »> 

IF jtype " JumpC THEN 
BEGIN 

IF jbytes > LAST[BYTE] THEN RETURN[FALSE]; 
j - cb[j].flink; 
END 
ELSE RETURN[TRUE]; 
ENDCASE «> RETURN[TRUE] 
ENDLOOP 
END; 



ProcessGlobalStrings: PUBLIC PROCEDURE [framestart: CARDINAL] RETURNS [nextnewf rame: CARDINAL] 
BEGIN 

f irstnewcode, nextnewcode: CARDINAL ♦- movetocodeword[] ; 
stsize: CARDINAL; 

dostring; PROCEDURE [msti: MSTIndex] » 
BEGIN 

nw: CARDINAL; 
IF (stb+msti).info « THEN 

BEGIN (stb+msti). local <- TRUE; RETURN END; 
nw ^ StringDefs.WordsForString[{stb+msti) .string. length]; 
{stb+msti ). info <- nextnewf rame; 
nextnewframe ♦- nextnewf rame+nw; 
(stb+msti ) .codelndex <- nextnewcode; 
nextnewcode ^ nextnewcode + nw; 

[] ^ StreamDef s.WriteBlock[MPtr.objectStream, 0(stb+msti) .string, nw]; 
codeindex ^ codeindex+nw; 
END; -- of dostring 

nextnewframe <- framestart; 

LitDef s.EnumerateMasterStrings[dostring]; 

stsize <- nextnewframe - framestart; 

IF stsize > THEN BLTStrings[f irstnewcode, stsize, framestart, FALSE]; 

END; 
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ProcessLocalStrings: PUBLIC PROCEDURE [f ramestart: CARDINAL, first: STIndex] RETURNS [nextnewf rame: C 
"♦ARDINAL] ■ 
BEGIN 

nstrings: CARDINAL ^ 0; 

countstrings: PROCEDURE [msti: MSTIndex] ■ 
BEGIN 
IF (stb+msti). local AND (stb+msti) .codelndex # THEN 

nstrings ^ nstrings+l; 
END; 
f irstnewcode, nextnewcode: CARDINAL <- movetocodeword[] ; 
stsize, i, nw: CARDINAL; 

cursize: CARDINAL ♦■ 0; 

Stringlnfo: TYPE - RECORD [offset: CARDINAL, sti: MSTIndex]; 
star: DESCRIPTOR FOR ARRAY OF Stringlnfo; 
insertstrings: PROCEDURE [msti: MSTIndex] - 
BEGIN 

i, CO. nw: CARDINAL; 
IF (stb+msti). local THEN 
BEGIN 

CO <- (stb+msti). codelndex; 
IF CO # THEN 
BEGIN 

FOR i <- cursize. i-1 WHILE i>0 AND co < star[i-l].off set DO 
star[i] ^ star[i-l]; 
ENDLOOP; 
star[i] <r [co. msti]; 
cursize <- cursize+1; 
END 
ELSE 
BEGIN 

nw <r StringDefs.WordsForString[(stb+msti) .string. length]; 
(stb+msti ). info ♦- nextnewf rame; 
nextnewframe ♦- nextnewf rame+nw; 
(stb+msti ) .codelndex ^ nextnewcode; 
nextnewcode <- nextnewcode + nw; 

[] ♦" StreamDef s.WriteBlock[MPtr.objectStream, 0(stb+msti) .string, nw]; 
codeindex ♦- codeindex+nw; 
END; 
END; 
END; -- of insertstrings 

nextnewframe ^ framestart; 

LitDef s.EnumerateLocalStrings[f irst. countstrings]; 
IF nstrings # THEN 
star ♦- DESCRIPTOR[ 

SystemDefs,AnocateHeapNode[nstrings*SIZE[StringInfo]]. 
nstrings]; 
LitDef s. EnumerateLocalStrings[f irst. insertstrings]; 
stsize ^ nextnewframe - framestart; 

IF stsize > THEN BLTStrings[f irstnewcode, stsize. framestart, TRUE]; 
i <r 0; 
WHILE i < nstrings DO 

framestart <- nextnewframe; 

nextnewcode ♦- firstnewcode ♦- star[i] .offset; 

WHILE i < nstrings AND star[i] .of f set * nextnewcode DO 

nw ^ StringDefs.WordsForString[(stb+star[i]. sti) .string. length]; 
nextnewcode *- nextnewcode + nw; 
(stb+star[i]. sti ). info <- nextnewframe; 
nextnewframe ^ nextnewf rame+nw; 
i *- i+1; 
ENDLOOP; 
stsize <- nextnewframe - framestart; 
BLTStrings[f irstnewcode, stsize, framestart, TRUE]; 
ENDLOOP; 
IF nstrings # THEN SystemDef s . FreeHeapNode[BASE[star]] ; 
END; 

BLTStrings: PROCEDURE [coffset, length, foffset: CARDINAL, local: BOOLEAN] - 
BEGIN OPEN FOpCodes; 
RequireStack[0]; 
push! itval [coffset]; 
push! itval[length]; 

Cioutl[IF local THEN qLADRB ELSE qGADRB, foffset]; 
CioutO[qBLTC]; 
END; 
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endcodefile: PUBLIC PROCEDURE RETURNS [nbytes: CARDINAL] - 
BEGIN 

OPEN SystemDefs, StreamDefs; 
saveindex: Streamlndex; 
[] ^ mov8tocodeword[]; 

MPtr.fgTable ^ DESCRIPTOR[BASE[f gt], fgti+1]; 
MPtr.codeSeg. pages <- (codeindex+(PageSize-l))/PageSize; 
saveindex *- GetInd8x[MPtr.objectStream]; 
Set Index [MPtr.objectStream, en try base]; 
[] <r WriteBlock[MPtr.objectStream, 

BASE[entryvector], 

LENGTH[en try vector ]*SIZE[Contro1Defs.EntryVectorI tern]]; 
FreeSegment[BASE[entry vector]]; 
MPtr.mtRoot.framesize <- MPtr .objectFrameSize; 
MPtr.mtRoot.fsi ^ computeframesize[MPtr .objectFrameSize]; 
MPtr. mtRoot. code. length <- codeindex*2; 
SetIndex[MPtr.objectStream, saveindex]; 
RETURN [codeindex*2] 
END; 

END... 



